In this post, we look at how the geographic pattern of shootings in Baltimore may have changed in recent years.
The complete R script needed to get the data and reproduce these analyses is posted in the document, but the snippets are hidden unless you reveal them. For example, clicking code to the bottom-right of this sentence reveals the R script you would use to download all the data on shootings.
library(tidyverse)
library(scales)
library(knitr)
library(leaflet)
library(geojsonio)
bpd <- read_csv("https://raw.githubusercontent.com/peterphalen/ceasefire/master/BPD_Part_1_Victim_Based_Crime_Data.csv")
# subset to shootings or homicides with a firearm
bpd <- subset(bpd, Description == "SHOOTING" |
(Description == "HOMICIDE" & Weapon == "FIREARM"))
bpd$CrimeDate <- as.Date(bpd$CrimeDate, format = "%m/%d/%Y")
# get polygons to draw neighborhood maps
nbds <- geojsonio::geojson_read("/Users/peterphalen/Documents/ceasefire/Neighborhoods.geojson", what = "sp")
We’re going to start by looking at monthly shooting counts in Baltimore as broken down by district.
Here is a map of all the districts. The holes in the map are neighborhoods that had zero observed shootings between 2012 and 2019.
bpd <- bpd[complete.cases(bpd$District, bpd$Neighborhood),]
# remove ERN suffixes to match local talk
bpd$District <- with(bpd, gsub(District,
pattern="*ERN",
replacement =""))
# a few (~20) neighborhoods have been coded in two different districts, presumably on accident
# we just pick the first district for the purposes of this map.
district.index <- bpd %>% group_by(Neighborhood) %>% summarise(District = unique(District)[1])
get_district <- function(neighborhood){
nbd <- as.character(neighborhood)
if (nbd %in% district.index$Neighborhood){
dist <- district.index[which(district.index$Neighborhood == nbd),]$District
return(dist)
}else{
return(NA)
}
}
nbds$district <- sapply(nbds$Name, get_district)
gg_color_hue <- function(n) {
hues = seq(15, 375, length = n + 1)
hcl(h = hues, l = 65, c = 100)[1:n]
}
labs <- unique(bpd$District)
pal.districts <- colorFactor(gg_color_hue(length(labs)),
labs,
na.color="#80808000")
leaflet(nbds) %>%
addProviderTiles(providers$CartoDB.PositronNoLabels) %>%
addPolygons(stroke=T,
weight=.5,
color=~pal.districts(district),
popup=ifelse(!is.na(nbds$district), paste0(nbds$Name," (",nbds$district,")"),"No shootings recorded in this area"),
fillOpacity=.5) %>%
addLegend("bottomright",title="Districts",colors=~pal.districts(labs),labels=~labs)
We plot monthly shooting counts by district to see how gun violence is progressing in different areas.
library(lubridate)
bpd$month <- month(bpd$CrimeDate)
bpd$year <- year(bpd$CrimeDate)
# drop last month cuz incomplete
bpd <- subset(bpd, !(month == 6 & year == 2019))
count <- bpd %>%
group_by(year, month, District) %>%
summarise(total.count=n())
# we need to account for months with zero shootings
get.zeros <- expand.grid(2012:2018, 1:12, unique(bpd$District))
get.zeros <- rbind(get.zeros, expand.grid(2019, 1:5, unique(bpd$District)))
names(get.zeros) <- c("year", "month", "District")
count <- full_join(get.zeros,count)
count <- count %>% mutate_all(funs(ifelse(is.na(.),0,.)))
count <- count[order(count$District, count$year, count$month), ]
count$date <- as.Date(with(count,
paste(year,month,15, sep="-"),
format="%Y-%m-%d"))
subset(count) %>%
ggplot() +
aes(x=date, y=total.count,group=District, color=District) +
geom_point(alpha=.2) +
stat_smooth(alpha=.5, se=F) +
xlab("date") +
ylab("Number of monthly shootings") +
scale_x_date(date_labels = "%Y", date_breaks="1 year") +
theme_classic() +
ggtitle("")
West, Southwest, and East Baltimore have the most shootings.
It looks like there’sx been a major increase in shootings in Southeast Baltimore in the past year or two. This increase was largely due to shootings in those Southeastern neighborhoods immediately adjacent to East Baltimore, such as McElderry Park, Dunbar-Broadway, and the Baltimore Highlands, as you can see in the maps below.
Here are two maps of the shootings that have happened this year, to give a more fine-grained picture of where people are getting hurt or killed.
You can tap neighborhoods to see exact numbers.
It’s important to remember that all heatmaps of data are misleading, so you need to look at both maps to get an idea of what’s happening.
This map shows the raw count of murders in Baltimore by neighborhood. It’s important to note that raw count maps will overestimate shootings in areas with many residents (like Frankford) and understimate shootings in areas with fewer residents (like Penn North).
bpd <- subset(bpd, !is.na(Neighborhood) & year(CrimeDate) >= 2019)
# count by neighobrhood
count <- bpd %>%
group_by(Neighborhood) %>%
summarise(total.count=n())
get_shooting_count <- function(neighborhood){
nbd <- as.character(neighborhood)
if(nbd %in% count$Neighborhood){
count <- count[count$Neighborhood == nbd,]$total.count
return(count)
}
if(!(nbd %in% count$Neighborhood)){
return(0)
}
}
nbds$count <- sapply(nbds$Name, get_shooting_count)
# draw legend
range.count <- range(nbds$count,na.rm=T)
labs <- c(0,5,10,15)
pal.crime <- colorNumeric(colorRamp(c('#ccccff', 'red')), labs)
leaflet(nbds) %>%
addProviderTiles(providers$CartoDB.PositronNoLabels) %>%
addPolygons(stroke=T,
weight=1,
popup=paste0(nbds$Name,"<br/>Shootings: ",nbds$count),
color=~pal.crime(count),
fillOpacity=.5) %>%
addLegend("bottomright",title="# of shootings (2019)",colors=~pal.crime(labs),labels=~labs)
This version adjusts by the population of each neighborhood. Be careful about super bright red areas: some neighborhoods have very few residents and so even a single shooting will make them look really dangerous even though they’re probably not. (You can tap neighborhoods to see the number of residents.)
The “University of Maryland” neighborhood had an absurd 7 shootings for just 387 residents, so I took it out of this population-adjusted map. There were probably some unsolved shootings where the victim was dropped off at the hospital that were coded as simply having happened at the hospital.
#--------- population-adjusted --------------#
nbds$per1k <- nbds$count / nbds$Population * 1000
nbds$per1k <- round(nbds$per1k)
nbds$per1k <- ifelse(nbds$Population == 0, NA, nbds$per1k)
labs <- c(0,2,4,6,8,10)
pal.crime <- colorNumeric(colorRamp(c('#ccccff', 'red')),
labs,
na.color = "#b2b2b2")
countlabel <- paste0(nbds$Name,"<br/>",nbds$count," shootings among ",nbds$Population," residents")
nbds$countlabel <- ifelse(nbds$Population == 0, paste0(nbds$Name,":<br/>","No residents"), countlabel)
leaflet(nbds) %>% #draw population-adjusted map,
#areas with 0 residents are greyed
#out but can still be clicked
addProviderTiles(providers$CartoDB.PositronNoLabels) %>%
addPolygons(stroke=T,
weight=1,
popup=nbds$countlabel,
color=~pal.crime(per1k),
fillOpacity=.6) %>%
addLegend("bottomright",title="Shootings per one</br>thousand residents</br>(2019)",colors=~pal.crime(labs),labels=~labs)
West, East, and Southwest Baltimore are experiencing the most shootings right now.
West Baltimore still has the most shootings of any district, but East Baltimore has seen a noticeable increase in the last few months and is now essentially tied for first.
The current year increase in shootings that we’re measuring in the city of Baltimore is almost entirely due to increases in Southeast/East Baltimore, but especially the neighborhoods just outside of the Hopkins area (like Dunbar-Broadway, Broadway East, and McElderry Park).